Imports Microsoft.VisualBasic
Imports System
Imports System.Collections
Imports System.Text
Imports Cforge.Net
Imports Cforge.Security.Certificates

Namespace ImapClientDemo.Security
	''' <summary>
	''' A custom certificate validator implementing the interface ICertificateValidator that allow user to decide whether to accept or reject the server's certificate.
	''' </summary>
	Friend Class CustomCertValidator
		Implements ICertificateValidator
		Private Shared ReadOnly acceptedCertificates As New Hashtable() ' A list that maintains accepted certificates.

		''' <summary>
		''' Returns all issues of the given certificate.
		''' </summary>
		''' <param name="res">The certificate validation result.</param>
		''' <param name="status">The certificate validation status.</param>
		''' <param name="addToTrustedListForm">reference to a boolean flag indicating whether the "Add To Trusted List" button will be shown.</param>
		''' <returns></returns>
		Private Shared Function GetCertProblem(ByVal res As CertificateValidationResult, ByVal status As CertificateValidationStatus, ByRef addToTrustedListForm As Boolean) As String
			Select Case status
				Case CertificateValidationStatus.TimeNotValid
					Return "Server certificate has expired or is not valid yet."

				Case CertificateValidationStatus.Revoked
					Return "Server certificate has been revoked."

				Case CertificateValidationStatus.UnknownCA
					Return "Server certificate was issued by an unknown authority."

				Case CertificateValidationStatus.RootNotTrusted
					' The "Add To Trusted List" button will be shown.
					addToTrustedListForm = True
					Return "Server certificate was issued by an untrusted authority."

				Case CertificateValidationStatus.IncompleteChain
					Return "Server certificate does not chain up to a trusted root authority."

				Case CertificateValidationStatus.Malformed
					Return "Server certificate is malformed."

				Case CertificateValidationStatus.CNNotMatch
					Return "Server hostname does not match the certificate."

				Case CertificateValidationStatus.UnknownError
					Return String.Format("Error {0:x} encountered while validating server's certificate.", res.ErrorCode)

				Case Else
					Return status.ToString()
			End Select
		End Function

		''' <summary>
		''' Validates a certificate.
		''' </summary>
		''' <param name="info">The certificate validator request info.</param>
		''' <returns>A boolean value indicating whether the chain is accepted or not. True to accept the chain, False to reject.</returns>
        Public Function Validate(ByVal info As CertificateValidatorRequestInfo) As TlsSslCertificateAcceptance Implements ICertificateValidator.Validate
            ' Validate the certificate and return the validation result.
            Dim res As CertificateValidationResult = info.CertificateChain.Check(info.ServerCommonName, 0)

            ' If it's valid? no need to show the form.
            If res.Valid Then
                Return TlsSslCertificateAcceptance.Acceptable
            End If

            Dim status As CertificateValidationStatus = res.Status

            Dim values() As CertificateValidationStatus = CType(System.Enum.GetValues(GetType(CertificateValidationStatus)), CertificateValidationStatus())

            Dim addToTrustedListForm As Boolean = False
            Dim sbIssues As New StringBuilder()
            For i As Integer = 0 To values.Length - 1
                ' Matches the validation status?
                If (status And values(i)) = 0 Then
                    Continue For
                End If

                ' The issue is processed.
                status = status Xor values(i)

                ' Get the issue's description and append to the issue list.
                sbIssues.AppendFormat("{0}" & Constants.vbCrLf, GetCertProblem(res, values(i), addToTrustedListForm))
            Next i

            ' Get the first certificate from the chain.
            Dim cert As X509Certificate = info.CertificateChain(0)

            ' If the certificate is already saved then return Accept.
            If acceptedCertificates.Contains(Convert.ToBase64String(cert.GetHash())) Then
                Return TlsSslCertificateAcceptance.Acceptable
            End If

            ' Show the validation form.
            Dim certForm As New CertValidator()
            certForm.Certificate = cert
            certForm.ShowAddToTrustedList = addToTrustedListForm
            certForm.Issues = sbIssues.ToString()

            certForm.ShowDialog()

            ' Add certiticate of the issuer CA to the trusted list.
            If certForm.AddToTrustedList Then
                Dim trustedCaStore As New CertificateStore(CertificateStoreNameType.Root)
                Dim rootCertificate As X509Certificate = info.CertificateChain(info.CertificateChain.Count - 1)

                ' Add to the trusted list.
                trustedCaStore.AddCertificate(rootCertificate)
            End If

            If certForm.Accepted Then
                ' Save accepted certificate.
                acceptedCertificates.Add(Convert.ToBase64String(cert.GetHash()), cert)
                Return TlsSslCertificateAcceptance.Acceptable
            End If

            If (res.Status And CertificateValidationStatus.TimeNotValid) <> 0 Then
                Return TlsSslCertificateAcceptance.Expired ' Expired certificate.
            End If
            If (res.Status And CertificateValidationStatus.Revoked) <> 0 Then
                Return TlsSslCertificateAcceptance.Revoked ' Revoked certificate.
            End If
            If (res.Status And (CertificateValidationStatus.UnknownCA Or CertificateValidationStatus.RootNotTrusted Or CertificateValidationStatus.IncompleteChain)) <> 0 Then
                Return TlsSslCertificateAcceptance.UnknownAuthority ' Unknown authority.
            End If
            If (res.Status And (CertificateValidationStatus.Malformed Or CertificateValidationStatus.UnknownError)) <> 0 Then
                Return TlsSslCertificateAcceptance.Other
            Else
                Return TlsSslCertificateAcceptance.Unknow
            End If
        End Function
	End Class
End Namespace
